perm filename BOOTFN.L70[L70,TES] blob sn#017426 filedate 1972-12-13 generic text, type T, neo UTF8
00100	FUNCTION IN?$ATOM (TYPE TYP; STRING S) =
00200		FOR INTEGER NN ← FREE?$WORD(FORM?$FROM?$TYPE(TYP)) - 1 TO 0 BY -1
00300			SEARCH UNTIL S STRING?$EQUAL PNAME(DESCR(TYP, 0, NN))
00400			IN WHICH CASE DESCR(TYP, 0, NN)			% ALREADY IN THE OBLIST %
00500			OTHERWISE LAMBDA(R); R([S,NIL]); (NAME(TYP));	% NOT IN THE OBLIST %
00600	
00700	
00800	FUNCTION IN?$NUMBER (BYTE?$VECTOR N) =
00900		BEGIN
01000		SHORT?$INTEGER I;
01100		INTEGER SUM, INT, FRAC, DIGITS, FRACDIGITS;
01200		BOOLEAN ISREAL, HASEXP;
01300		SUM ← DIGITS ← 0;
01400		FOR INTEGER I IN N DO
01500			IF I = UNASCII('?.) THEN
01600				BEGIN
01700				INT ← SUM; ISREAL ← T; SUM ← DIGITS ← 0;
01800				END
01900			ELSE IF I = UNASCII('E) THEN
02000				BEGIN
02100		IF PREFACE?$INCR > 0 THEN I ← FIND?$BACK?$POINTER(DATA) + (HAD+35)/36
02200			ALSO _BLT(PREFACE?$INCR, I, I+1) ; % ZERO OUT MARK BITS %
02300				HASEXP ← TRUE;
02400				IF ISREAL THEN
02500					BEGIN
02600					FRACDIGITS ← DIGITS;
02700					FRAC ← SUM;
02800					SUM ← DIGITS ← 0;
02900					END
03000				ELSE	BEGIN
03100					INT ← SUM;
03200					SUM ← DIGITS ← 0;
03300					END
03400				END
03500			ELSE	BEGIN
03600				DIGITS ← DIGITS + 1;
03700				SUM ← SUM*10 + I-UNASCII('0);
03800				END;
03900		RETURN 	IF ¬(HASEXP|ISREAL) THEN SUM
04000			ELSE IF ISREAL & ¬HASEXP THEN
04100				FLOAT(INT) + FLOAT(SUM)/EXP(10,DIGITS)
04200			ELSE IF ISREAL THEN
04300				(FLOAT(INT) + FLOAT(FRAC)/EXP(10,FRACDIGITS)) * EXP(10,SUM)
04400			ELSE INT * EXP(10,SUM);
04500		END;
04600	
04700	
04800	FUNCTION IN?$STRING (STRING N) = STRING(N);	
04900	
05000	
05100	
05200	FUNCTION intern (A) =
05300		IF NAME(TYPEF(A)) EQ 'identifier THEN A
05400		ELSE INTERN?$MAKNAM(PNAME(A));
05500	
05600	
05700	FUNCTION INTERN?$MAKNAM (STRING S) =
05800		IN?$ATOM('identifier.?&TYPE, S);
05900	
06000	
06100	
06200	
06300	FUNCTION MAKE?$FUNCTION (DESC; INTEGER LEN) =
06400		BEGIN  INTEGER B;
06500		B ← GET?$BLOCK(DESC, 0, LEN, 0);
06600		_CORE(_EFFECTIVE(DESC), INTEGER) ← RIGHT?$HALF(B);
06700		RETURN DESC;
06800		END;
06900	
07000	
07100	FUNCTION MAKE?$HASHED?$STRINGS (TYPE TYP; INTEGER INIT, GROW) =
07200		BEGIN  PRIVATE OBL;
07300		OBL ← RECORD(TYP, [0, GROW, MAKE?$WORD?$VECTOR(INIT,NIL), MAKE?$WORD?$VECTOR(INIT, NIL)]);
07400		RETURN OBL;
07500		END;
07600	
07700	
07800	FUNCTION MAKE?$L70?$ATOM(X) =
07900		% INTERN?$MAKNAM(string(STR(X))); %
08000		IF X.ATM THEN X.ATM ELSE X.ATM ← identifier(string(STR(X)), NIL);	% FOR NOW %
08100	
08200	
08300	FUNCTION MAKE?$L70?$FUNCTION (X) =
08400		BEGIN PRIVATE TMP,M;
08500		TMP← MAKE?$L70?$ATOM(X);
08600		PROPERTIES(TMP) ← MAKE?$L70?$LIST(['FUNCTION, M ← MAKE?$ENTITY('identifier.?&TYPE)]);
08700		_CORE((M)) ← ['?&INSTRUCTION, '(JRST 0 UNDECLARED?$FUNCTION)];
08800		RETURN TMP;
08900		END;
09000	
09100	
09200	FUNCTION MAKE?$PROCESS (TYPE TYP; INTEGER VARS; INTEGER PSTACK?$SIZE) =
09300		BEGIN  PRIVATE DATA, DESC;   PRIVATE VALUE?$CELL VALCELL;
09400		DESC ← MAKE?$SOLITARY?$ENTITY(TYP, 1, 2*VARS);
09500		DATA ← DATA?$AREA(DESC);
09600		_CORE(DATA-2) ← 2*VARS;						% SET LENGTH %
09700		VALCELL ← DATA ;
09800		VALUE(VALCELL) ← MAKE?$PUSHDOWN('STACK.?&TYPE, PSTACK?$SIZE);	% SET UP THE P STACK %
09900		CONTEXT(VALCELL) ← CONTEXT;
10000		FOR INTEGER N ← DATA+3 TO DATA + 2*VARS BY 2 DO
10100			BEGIN
10200			VALCELL ← N;
10300			VALUE(VALCELL)   ← 'UNBOUND;
10400			CONTEXT(VALCELL) ← CONTEXT;
10500			END;
10600		RETURN DESC;
10700		END;
10800	
10900	
11000	FUNCTION MAKE?$PUSHDOWN (TYPE TYP; INTEGER LEN) =
11100		BEGIN  PRIVATE DESC;   PRIVATE INTEGER BASE;
11200		DESC ← MAKE?$SOLITARY?$ENTITY(TYP, 1, LEN+1);
11300		BASE ← DATA?$AREA(DESC) ;
11400		_CORE(BASE-2) ← PDP10?$STACK?$POINTER(LEN, BASE);	% STACK POINTER IS STORED IN BASE-2 %
11500		RETURN DESC;
11600		END;
11700	
11800	
11900	FUNCTION MAKE?$SOLITARY?$ENTITY (TYPE TYP; INTEGER PREFACE, DATA?$SIZE) =
12000		BEGIN  PRIVATE DESC;
12100		DESC ← MAKE?$ENTITY(TYP);		% GET A MAP TABLE CELL %
12200		GET?$BLOCK(DESC, PREFACE, DATA?$SIZE, 0) ;	
12300		RETURN DESC;
12400		END;
12500	
12600	
12700	FUNCTION MAKE?$SYMBOL?$TABLE (INTEGER LEN) = MAKE?$PUSHDOWN('SYMBOL?$TABLE.?&TYPE, LEN);
12800	
12900	
13000	FUNCTION maknam (STRING S) = MADE?$NAME(S, NIL);		% MADE?$NAME(STRING, PROPERTY LIST) %
13100	
13200	
13300	
13400	FUNCTION ADD?$SYMBOL (NAME, VALU, TABLE) = PUSH(TABLE, [NAME, VALU]);
13500	
13600	
13700	
     

00100	_EOF_